home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / Yerk 3.6.8 / Float source / fpCode < prev    next >
Encoding:
Text File  |  1996-03-07  |  7.0 KB  |  224 lines  |  [TEXT/YERK]
  1. \ code words for floating point support
  2. \  8/13/85  cbd Version 1.0
  3. \  1/24/86  gdc Moved f0=, f0>, and f0< to fpcode.
  4. \  3/07/96    rfl wow, 10 years!! added float>s and s>float for C interfaces
  5.  
  6. \ ( flt1 flt2 -- abs1 abs2)  set up stack for comparison, kill floats
  7. \ leaves D0,D1 and a0,a1 undefined.
  8. :CODE  (fcmp2)      \ ***** subroutine ****
  9.         move.l  (A7)+,a2
  10.         move.l  (A7)+,D1    ; get 2 floats in D0,D1
  11.         move.l  (A7)+,D0
  12.         pea     2(A3,D1.l)  ; push abs data addresses
  13.         pea     2(A3,D0.l)
  14.         move.l  YERK[(fltDisp2)],d7     ; get subr addr in d7
  15.         jsr     0(a3,d7.l)              ; go kill floats in D0,D1
  16.         jmp     (a2)
  17. ;CODE
  18.  
  19. \ =================== Comparison operators ==============
  20. \ Stack frame for all comparisons:
  21. \ ( float1 float2 -- bool )
  22. :CODE f>
  23.         move.l  YERK[(fcmp2)],d7     ; get subr addr in d7
  24.         jsr     0(a3,d7.l)           ; go kill floats in D0,D1
  25.         MOVE.W  #8,-(A7)    ; code for FCMPX
  26.         call    pack4
  27.         sgt     D0
  28.         move.l  D0,-(A7)
  29. ;CODE
  30.  
  31. :CODE f<
  32.         move.l  YERK[(fcmp2)],d7     ; get subr addr in d7
  33.         jsr     0(a3,d7.l)              ; go kill floats in D0,D1
  34.         MOVE.W  #8,-(A7)    ; code for FCMPX
  35.         call    pack4           
  36.         slt     D0
  37.         move.l  D0,-(A7)
  38. ;CODE
  39.  
  40. :CODE f=  
  41.         move.l  YERK[(fcmp2)],d7     ; get subr addr in d7
  42.         jsr     0(a3,d7.l)              ; go kill floats in D0,D1
  43.         MOVE.W  #8,-(A7)    ; code for FCMPX
  44.         call pack4           
  45.         seq     D0
  46.         move.l  D0,-(A7)
  47. ;CODE
  48.  
  49. :CODE f<>  
  50.         move.l  YERK[(fcmp2)],d7     ; get subr addr in d7
  51.         jsr     0(a3,d7.l)              ; go kill floats in D0,D1
  52.         MOVE.W  #8,-(A7)    ; code for FCMPX
  53.         call pack4           
  54.         sne     D0
  55.         move.l  D0,-(A7)
  56. ;CODE
  57.  
  58. :CODE f<=  
  59.         move.l  YERK[(fcmp2)],d7     ; get subr addr in d7
  60.         jsr     0(a3,d7.l)              ; go kill floats in D0,D1
  61.         MOVE.W  #8,-(A7)    ; code for FCMPX
  62.         call pack4           
  63.         sle     D0
  64.         move.l  D0,-(A7)
  65. ;CODE
  66.  
  67. :CODE f>=  
  68.         move.l  YERK[(fcmp2)],d7     ; get subr addr in d7
  69.         jsr     0(a3,d7.l)              ; go kill floats in D0,D1
  70.         MOVE.W  #8,-(A7)    ; code for FCMPX
  71.         call pack4           
  72.         sge     D0
  73.         move.l  D0,-(A7)
  74. ;CODE
  75.  
  76. \ ================ Arithmetic operators ==============
  77. \ ( flt1 flt2 -- abs2 abs1)  set up stack for operator, kill float in d0
  78. :CODE  (fp1)      \ ***** subroutine ****
  79.         move.l  (A7)+,a2    ; hold return address 
  80.         move.l  (A7)+,D0    ; get 2 floats in D0,D1
  81.         move.l  (A7)+,D1    ; 
  82.         pea     2(A3,D0.l)  ; push abs data addresses       
  83.         pea     2(A3,D1.l)  ; example op:  f1 - f2 -> f1       
  84.         move.l  YERK[(fltDisp)],d7     ; get subr addr in d7
  85.         jsr     0(a3,d7.l)              ; go kill float in D0
  86.         jmp     (a2)
  87. ;CODE
  88. \ --------------------------------------
  89. \ ( f1 f2 -- f1+f2)  result gets stored in f2's data 
  90. :CODE f+  
  91.         move.l  YERK[(fp1)],d7     ; get subr addr in d7
  92.         jsr     0(a3,d7.l)              ; go kill float  in D0 
  93.         clr.w   -(A7)    ; code for FADD
  94.         call pack4           
  95.         move.l  D1,-(A7)    ; 
  96. ;CODE
  97.  
  98. :CODE f-  
  99.         move.l  YERK[(fp1)],d7     ; get subr addr in d7
  100.         jsr     0(a3,d7.l)              ; go kill float  in D0 
  101.         MOVE.W  #2,-(A7)    ; code for FSUB
  102.         call pack4           
  103.         move.l  D1,-(A7)    ; 
  104. ;CODE
  105.  
  106. :CODE f*  
  107.         move.l  YERK[(fp1)],d7     ; get subr addr in d7
  108.         jsr     0(a3,d7.l)              ; go kill float  in D0 
  109.         MOVE.W  #4,-(A7)    ; code for FMULT
  110.         call pack4           
  111.         move.l  D1,-(A7)    ; 
  112. ;CODE
  113.  
  114. :CODE f/  
  115.         move.l  YERK[(fp1)],d7     ; get subr addr in d7
  116.         jsr     0(a3,d7.l)              ; go kill float  in D0 
  117.         MOVE.W  #6,-(A7)    ; code for FDIV
  118.         call pack4           
  119.         move.l  D1,-(A7)    ; 
  120. ;CODE
  121.  
  122. \ floating point modulus function
  123. :CODE fMod        
  124.         move.l  YERK[(fp1)],d7     ; get subr addr in d7
  125.         jsr     0(a3,d7.l)              ; go kill float  in D0 
  126.         MOVE.W  #12,-(A7)               ; code for FREM
  127.         call pack4           
  128.         move.l  D1,-(A7)    ; 
  129. ;CODE
  130.  
  131.  
  132. \ ============= unary operations ==============
  133. :CODE fNegate  
  134.         move.l  (A7),D0
  135.         pea     2(A3,D0.l)         
  136.         MOVE.W  #13,-(A7)     
  137.         call pack4           
  138. ;CODE
  139.  
  140. :CODE fAbs  
  141.         move.l  (A7),D0
  142.         pea     2(A3,D0.l)         
  143.         MOVE.W  #15,-(A7)     
  144.         call pack4           
  145. ;CODE
  146.  
  147. :CODE sqrt  
  148.         move.l  (A7),D0
  149.         pea     2(A3,D0.l)         
  150.         MOVE.W  #18,-(A7)     
  151.         call pack4           
  152. ;CODE
  153.  
  154. :CODE round  
  155.         move.l  (A7),D0
  156.         pea     2(A3,D0.l)         
  157.         MOVE.W  #20,-(A7)     
  158.         call pack4           
  159. ;CODE
  160.  
  161. :CODE trunc  
  162.         move.l  (A7),D0
  163.         pea     2(A3,D0.l)         
  164.         MOVE.W  #22,-(A7)     
  165.         call pack4           
  166. ;CODE
  167.  
  168. :CODE logBin  
  169.         move.l  (A7),D0
  170.         pea     2(A3,D0.l)         
  171.         MOVE.W  #26,-(A7)     
  172.         call pack4           
  173. ;CODE
  174.  
  175. \ ========= conversion to/from Yerk longInt  
  176. ( flt -- int32)
  177. :CODE float>  
  178.         move.l  (A7),D0             ; get source float
  179.         move.l  YERK[(fltDisp)],d7     ; get subr addr in d7
  180.         jsr     0(a3,d7.l)             ; go kill floats in D0 
  181.         move.l  (A7),D0             ; get source float
  182.         move.l  a7,a0           ; save ptr to the cell
  183.         pea     2(A3,D0.l)         
  184.         move.l  a0,-(a7)        ; push ptr to the cell 
  185.         MOVE.W  #10256,-(A7)    ; $2810   
  186.         call pack4           
  187. ;CODE
  188.  
  189. \ ( int32 -- fp )
  190. :CODE >float  
  191.         move.l  a7,-(a7)    ; push ptr to the long
  192.         move.l  YERK[(fltNew)],d7       ; get subr addr in d7
  193.         jsr     0(a3,d7.l)              ; go get float in D1
  194.         pea     2(a3,d1.l)                ; push addr of float
  195.         MOVE.W  #10254,-(A7)            ; $280e
  196.         call pack4           
  197.         move.l  D1,(A7)    ;  replace the long cell with float ptr
  198. ;CODE
  199.  
  200. \ convert long float (10 bytes) to short floats (4 bytes) for interface to C
  201. \ ( fp -- f32)
  202. :CODE float>s  
  203.         move.l  (A7),D0             ; get source float
  204.         move.l  YERK[(fltDisp)],d7     ; get subr addr in d7
  205.         jsr     0(a3,d7.l)             ; go kill floats in D0 
  206.         move.l  (A7),D0             ; get source float
  207.         move.l  a7,a0           ; save ptr to the cell
  208.         pea     2(A3,D0.l)         
  209.         move.l  a0,-(a7)        ; push ptr to the cell 
  210.         MOVE.W  #4112,-(A7)    ; $1010  
  211.         call pack4           
  212. ;CODE
  213.  
  214. \ ( f32 -- fp )
  215. :CODE s>float  
  216.         move.l  a7,-(a7)    ; push ptr to the long
  217.         move.l  YERK[(fltNew)],d7       ; get subr addr in d7
  218.         jsr     0(a3,d7.l)              ; go get float in D1
  219.         pea     2(a3,d1.l)                ; push addr of float
  220.         MOVE.W  #4110,-(A7)            ; $100e
  221.         call pack4           
  222.         move.l  D1,(A7)    ;  replace the long cell with float ptr
  223. ;CODE
  224.